::Perl -Sx "{0}" prepare {"Parameters"} > MacPerlTest.Run
:MacPerlTest.Run · MacPerlTest.Out
::Perl -Sx "{0}" evaluate {"Parameters"} MacPerlTest.Out
Delete MacPerlTest.Out MacPerlTest.Run
Exit 0

#!./perl
	
# $RCSfile: TEST,v $$Revision: 4.0.1.1 $$Date: 91/06/07 11:59:30 $

# This is written in a peculiar style, since we're trying to avoid
# most of the constructs we'll be testing for.

$| = 1;

$operation = shift;

if ($ARGV[0] eq '-v') {
    $verbose = 1;
    shift;
}

die "Run me from the :t directory" if (-f ':t:TEST');

if ($operation eq "prepare") {
	print "Set Exit 0\n";
	
	if ($ARGV[0] eq '') {
		 @ARGV = split(/[ \n]/,
			`echo :base:Å.t :comp:Å.t :cmd:Å.t :io:Å.t; echo :op:Å.t :lib:Å.t`);
	}
	
	$bad = 0;
	while ($test = shift) {
		if ($test =~ /^$/) {
			next;
		}
		$te = $test;
		chop($te);
		print "echo \'----- $te" . '.' x (20 - length($te)) . "\'\n";
		open(script,"$test") || die "Can't run $test.\n";
		$_ = <script>;
		close(script);
		if (/#!..perl(.*)/) {
			$switch = $1;
		} else {
			$switch = '';
		}
		print "::Perl$switch $test\n";
	}
} elsif ($operation eq "evaluate") {
	$_ = "";
	
tests: while (1)	{
		while (1) {
			last if /^-----/;
			last tests unless ($_ = <>);
		} 

		$_ =~ /----- (.*)/;
		
		print $1;
		$ok = 0;
		$next = 0;
		
		while (<>) {
			last if (/^-----/);
			
			if ($verbose) {
				print "\t$_";
			}
			unless (/^#/) {
				if (/^1\.\.([0-9]+)/) {
					$max = $1;
					$totmax += $max;
					$files += 1;
					$next = 1;
					$ok = 1;
				 } else {
					$next = $1, $ok = 0, last if /^not ok ([0-9]*)/;
					if (/^ok (.*)/ && $1 == $next) {
						$next = $next + 1;
					} else {
						$ok = 0;
					}
				}
			}
		}
    	$next = $next - 1;
    	if ($ok && $next == $max) {
			print "ok\n";
    	} else {
			$next += 1;
			print "FAILED on test $next\n";
			$bad = $bad + 1;
		}
		
		last unless /^-----/ ||Ê!$ok;
	}
	if ($bad == 0) {
		if ($ok) {
			print "All tests successful.\n";
		} else {
			die "FAILED--no tests were run for some reason.\n";
		}
	} else {
		if ($bad == 1) {
			print "Failed 1 test.\n";
		} else {
			print "Failed $bad tests.\n";
		}
	}
}